Attribute VB_Name = "mdlLevel"
Option Explicit

Public Type typeLevelData
 LevelNo As Integer
 LevelName As String
 LevelHint As String
 LevelData(1 To 16, 1 To 10) As Integer
 DweepStartX As Integer
 DweepStartY As Integer
 ItemStart(1 To 10) As Integer
 ItemCount As Integer
End Type

Public LevelPackFile As String
Public LevelPackName As String

Public LData As typeLevelData

Private m_reg As clsFakeRegistry

Public Function reg2_GetSettings(ByVal sName As String, Optional ByVal sDefault As String) As String
Dim s As String
If Not GetKeyValue("Software\MyDweep", sName, s) Then s = sDefault
reg2_GetSettings = s
End Function

Public Sub reg2_SaveFile()
If m_reg Is Nothing Then
 Set m_reg = New clsFakeRegistry
 m_reg.LoadFile App.Path + "\My Dweep.cfg"
End If
m_reg.SaveFile
End Sub

Public Function GetKeyValue(KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
If m_reg Is Nothing Then
 Set m_reg = New clsFakeRegistry
 m_reg.LoadFile App.Path + "\My Dweep.cfg"
End If
GetKeyValue = m_reg.GetKeyValue(KeyName, SubKeyRef, KeyVal)
End Function

Public Function SetKeyValue(KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
If m_reg Is Nothing Then
 Set m_reg = New clsFakeRegistry
 m_reg.LoadFile App.Path + "\My Dweep.cfg"
End If
SetKeyValue = m_reg.SetKeyValue(KeyName, SubKeyRef, KeyVal)
End Function

'Public Function SetDefaultValue(ByVal hKey As Long, ByVal Subkey As String, ByVal value As String) As Boolean
'Dim ret As Long, lenS As Long, s As String
'ret = RegSetValue(hKey, Subkey, REG_SZ, value, LenB(StrConv(value, vbFromUnicode)) + 1)
'SetDefaultValue = (ret = 0)
'End Function

'Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
'    Dim i As Long                                           ' Loop Counter
'    Dim rc As Long                                          ' Return Code
'    Dim hKey As Long                                        ' Handle To An Open Registry Key
'    Dim hDepth As Long                                      '
'    Dim KeyValType As Long                                  ' Data Type Of A Registry Key
'    Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
'    Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
'    '------------------------------------------------------------
'    ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
'    '------------------------------------------------------------
'    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
'
'    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
'
'    tmpVal = String$(1024, 0)                              ' Allocate Variable Space
'    KeyVal = ""
'    KeyValSize = 1024                                       ' Mark Variable Size
'
'    '------------------------------------------------------------
'    ' Retrieve Registry Key Value...
'    '------------------------------------------------------------
'    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
'                         KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
'
'    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
'
'    If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
'        tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
'    Else                                                    ' WinNT Does NOT Null Terminate String...
'        tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
'    End If
'    '------------------------------------------------------------
'    ' Determine Key Value Type For Conversion...
'    '------------------------------------------------------------
'    Select Case KeyValType                                  ' Search Data Types...
'    Case REG_SZ                                             ' String Registry Key Data Type
'        KeyVal = tmpVal                                     ' Copy String Value
'    Case REG_DWORD                                          ' Double Word Registry Key Data Type
'        For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
'            KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
'        Next
'        KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
'    End Select
'
'    GetKeyValue = True                                      ' Return Success
'    rc = RegCloseKey(hKey)                                  ' Close Registry Key
'    Exit Function                                           ' Exit
'
'GetKeyError:      ' Cleanup After An Error Has Occured...
'    KeyVal = ""                                             ' Set Return Val To Empty String
'    GetKeyValue = False                                     ' Return Failure
'    rc = RegCloseKey(hKey)                                  ' Close Registry Key
'End Function


Public Function GetString(ByVal FileNo As Integer, ByVal lpStart As Long, Optional ByVal MaxLen As Long) As String
Dim lp As Long, str1 As String
Dim var1 As Byte, varc As Long
Dim dis As Boolean
dis = MaxLen = 0
lp = lpStart
Do
 Get #FileNo, lp, var1
 If var1 = 0 Then Exit Do
 If var1 > 128 Then
  varc = var1
  Get #FileNo, lp + 1, var1
  varc = varc * 256 + var1
  str1 = str1 + Chr(varc)
  lp = lp + 2
 Else
  str1 = str1 + Chr(var1)
  lp = lp + 1
 End If
Loop Until var1 = 0 Or (dis And lp - lpStart >= MaxLen)
GetString = str1
End Function

Public Function LoadLevelData(ByVal FileName As String, ByVal Level As Integer, destDat As typeLevelData) As Boolean
Dim i As Integer, j As Integer, lp As Long, var1 As Byte
Dim HasDweep As Boolean, MultiDweep As Boolean
Dim HasEnd As Boolean
Dim WrongMap As Boolean
On Error GoTo a
'Erase destDat
Open FileName For Binary As #1
With destDat
.LevelNo = Level
.LevelName = GetString(1, 51& + 488& * (Level - 1), 40)
.LevelHint = GetString(1, 91& + 488& * (Level - 1), 200)
.DweepStartX = 0
.DweepStartY = 0
For j = 1 To 10
 For i = 1 To 16
  lp = 274& + 488& * (Level - 1) + j * 16& + i
  Get #1, lp, var1
  If var1 = 5 Then
   .DweepStartX = i
   .DweepStartY = j
   'var1 = 0
   If HasDweep Then MultiDweep = True Else HasDweep = True
  End If
  If var1 = 4 Then HasEnd = True
  .LevelData(i, j) = var1
 Next i
Next j
For i = 1 To 10
 lp = 443& + 488& * (Level - 1) + i * 8#
 Get #1, lp, var1
 .ItemStart(i) = var1 * 10
 If var1 = 9 Then Exit For
 lp = lp + 4
 Get #1, lp, var1
 .ItemStart(i) = .ItemStart(i) + var1
Next i
.ItemCount = i - 1
End With
Close
WrongMap = HasDweep And HasEnd And Not MultiDweep
LoadLevelData = Not WrongMap
Exit Function
a:
Close
'Erase destDat
LoadLevelData = False
End Function

Public Function ChangeItemData(ByVal id As Integer) As Integer
Select Case id
Case 0, 100, 117
 ChangeItemData = 17
Case 10, 101
 ChangeItemData = 1
Case 11, 102
 ChangeItemData = 2
Case 12, 103
 ChangeItemData = 3
Case 13, 104
 ChangeItemData = 4
Case 20, 105
 ChangeItemData = 5
Case 21, 106
 ChangeItemData = 6
Case 30, 107
 ChangeItemData = 7
Case 31, 108
 ChangeItemData = 8
Case 32, 109
 ChangeItemData = 9
Case 33, 110
 ChangeItemData = 10
Case 40, 112
 ChangeItemData = 12
Case 41, 113
 ChangeItemData = 13
Case 50, 114
 ChangeItemData = 14
Case 60, 111
 ChangeItemData = 11
Case 70, 115
 ChangeItemData = 15
Case 80, 116
 ChangeItemData = 16
End Select
End Function

Public Sub PutGameData()
Dim i As Integer, j As Integer
GData.LevelNo = LData.LevelNo
For i = 1 To 16
 For j = 1 To 10
  GData.LevelData(i, j) = LData.LevelData(i, j)
  If GData.LevelData(i, j) = 5 Then GData.LevelData(i, j) = 0
 Next j
Next i
Erase GData.LevelLaser, GData.LevelState, GData.LevelExplode
GData.GameTime = 0
GData.DweepState = 0
GData.DweepX = LData.DweepStartX * 10 - 5
GData.DweepY = LData.DweepStartY * 10 - 5
GData.ItemCount = LData.ItemCount
For i = 1 To 10
 GData.ItemData(i) = LData.ItemStart(i)
Next i
GData.ItemNow = 0
End Sub

Public Sub GetGameData()
Dim i As Integer, j As Integer
LData.LevelNo = GData.LevelNo
For i = 1 To 16
 For j = 1 To 10
  LData.LevelData(i, j) = GData.LevelData(i, j)
 Next j
Next i
LData.DweepStartX = GData.DweepX \ 10 + 1
LData.DweepStartY = GData.DweepY \ 10 + 1
LData.LevelData(LData.DweepStartX, LData.DweepStartY) = 5
LData.ItemCount = GData.ItemCount
For i = 1 To 10
 LData.ItemStart(i) = GData.ItemData(i)
Next i
End Sub

Public Sub SetString(ByVal FileNo As Integer, ByVal lpStart As Long, ByVal stString As String, ByVal MaxLen As Long)
Dim lp As Long, str1 As String
Dim var1 As Byte, varc As Long
Dim lpS As Long
lp = lpStart
lpS = 1
Do
 If lpS > Len(stString) Then
  var1 = 0
  Put #FileNo, lp, var1
  lp = lp + 1
 Else
  varc = Asc(Mid(stString, lpS, 1))
  lpS = lpS + 1
  If varc < 0 Or varc > 255 Then
   If lp < MaxLen + lpStart - 1 Then
    varc = (varc + 65536) Mod 65536
    var1 = varc \ 256
    Put #FileNo, lp, var1
    var1 = varc And &HFF&
    Put #FileNo, lp + 1, var1
   End If
   lp = lp + 2
  Else
   var1 = varc
   Put #FileNo, lp, var1
   lp = lp + 1
  End If
 End If
Loop Until lp - lpStart >= MaxLen
End Sub

Public Function GetLong(ByVal FileNo As Integer, ByVal lpStart As Long) As Long
Dim varL As Long, var1 As Byte, i As Integer
varL = 0
For i = 1 To 3
 Get #FileNo, lpStart + 4 - i, var1
 varL = varL * 256 + var1
Next i
GetLong = varL
End Function

Public Sub SetLong(ByVal FileNo As Integer, ByVal lpStart As Long, ByVal num As Long)
Dim varL As Long, var1 As Byte, i As Integer
varL = num
For i = 1 To 3
 var1 = varL Mod 256
 Put #FileNo, lpStart + i - 1, var1
 varL = varL \ 256
Next i
End Sub

Public Function GetInteger(ByVal FileNo As Integer, ByVal lpStart As Long) As Long
Dim varL As Long, var1 As Byte, i As Integer
varL = 0
For i = 1 To 2
 Get #FileNo, lpStart + 2 - i, var1
 varL = varL * 256 + var1
Next i
GetInteger = varL
End Function

Public Sub SetInteger(ByVal FileNo As Integer, ByVal lpStart As Long, ByVal num As Long)
Dim varL As Long, var1 As Byte, i As Integer
varL = num
For i = 1 To 2
 var1 = varL Mod 256
 Put #FileNo, lpStart + i - 1, var1
 varL = varL \ 256
Next i
End Sub

Public Function FileExist(ByVal FileName As String) As Boolean
Dim var1 As String
On Error GoTo a
var1 = Dir(FileName)
FileExist = var1 <> ""
Exit Function
a:
FileExist = False
End Function

Public Function GetNextNotSolvedLevel(ByVal n As Integer) As Integer
Dim i As Integer, m As Integer, r As Integer
m = Len(lvPass)
For i = n To n + m - 1
 If Mid(lvPass, i Mod m + 1, 1) = "0" Then
  GetNextNotSolvedLevel = i Mod m + 1
  Exit Function
 End If
Next i
If m = n Then r = 1 Else r = n + 1
GetNextNotSolvedLevel = r
End Function

Public Sub GetLevelInfo(ByVal FileName As String, ByRef LevelName As String, ByRef LevelNo As Integer, ByRef Solved As Boolean)
Dim var1 As Byte
Open FileName For Binary As #1
LevelName = GetString(1, 3, 48)  '3-50
Get #1, 1, var1
LevelNo = var1
Get #1, 2, var1
Solved = var1 = 1
Close
End Sub

Public Sub SetLevelSolved(ByVal FileName As String, ByVal Solved As Boolean)
Dim var1 As Byte
Open FileName For Binary As #1
var1 = IIf(Solved, 1, 0)
Put #1, 2, var1
Close
End Sub

Public Function LoadCustomLevel(ByVal FileName As String, destDat As typeLevelData) As Boolean
Dim i As Integer, j As Integer, lp As Long, var1 As Byte
Dim HasDweep As Boolean, MultiDweep As Boolean
Dim HasEnd As Boolean
Dim WrongMap As Boolean
On Error GoTo a
'Erase destDat
Open FileName For Binary As #1
With destDat
Get #1, 1, var1
.LevelNo = var1
.LevelName = GetString(1, 3, 48)
.LevelHint = GetString(1, 51, 200)
.DweepStartX = 0
.DweepStartY = 0
For j = 1 To 10
 For i = 1 To 16
  lp = 250& + (j - 1) * 16& + i
  Get #1, lp, var1
  If var1 = 5 Then
   .DweepStartX = i
   .DweepStartY = j
   'var1 = 0
   If HasDweep Then MultiDweep = True Else HasDweep = True
  End If
  If var1 = 4 Then HasEnd = True
  .LevelData(i, j) = var1
 Next i
Next j
Get #1, 411, var1
.ItemCount = var1
For i = 1 To .ItemCount
 lp = 411 + i
 Get #1, lp, var1
 .ItemStart(i) = var1
Next i
End With
Close 1
WrongMap = HasDweep And HasEnd And Not MultiDweep
LoadCustomLevel = Not WrongMap
Exit Function
a:
Close 1
'Erase destDat
LoadCustomLevel = False
End Function

Public Sub SaveCustomLevel(ByVal FileName As String, destDat As typeLevelData)
Dim i As Integer, j As Integer, lp As Long, var1 As Byte
On Error GoTo a
'Erase destDat
Open FileName For Binary As #1
With destDat
var1 = .LevelNo
Put #1, 1, var1
SetString 1, 3, .LevelName, 48
SetString 1, 51, .LevelHint, 200
For j = 1 To 10
 For i = 1 To 16
  lp = 250& + (j - 1) * 16& + i
  var1 = .LevelData(i, j)
  Put #1, lp, var1
 Next i
Next j
var1 = .ItemCount
Put #1, 411, var1
For i = 1 To .ItemCount
 lp = 411 + i
 var1 = .ItemStart(i)
 Put #1, lp, var1
Next i
End With
Close
Exit Sub
a:
Close
End Sub

